home *** CD-ROM | disk | FTP | other *** search
- ' Program EX_0702.BAS
- ' Listing 15B - see documentation in TUTOR.SSS
-
- const ARRIVL = 1, STARTA = 2, ENDACT = 3, NEXTAC = 4
- const MATCH = 5
- const WHITE = 1, BLUE = 2, RED = 3, YELLOW = 4
- const MAINP = 1, COVER = 2, MREQ = 3
-
- common shared server, ecode
-
- declare sub prime ()
- declare sub find1 ()
- declare sub find2 ()
- declare function other ()
-
- rem $include: 'SSSB.H'
-
- call prime
-
- do
- ecode = NEXTEV
- if ecode > 0 then
- select case ecode
-
- case ARRIVL
- if IDE = MREQ then
- SCHED 0, MATCH, IDE
- else
-
- CREATE EX(12), IDE
- if RA < .35 then
- SETA 1, WHITE
- elseif RA < .5 then
- SETA 1, BLUE
- elseif RA < .8 then
- SETA 1, RED
- else
- SETA 1, YELLOW
- end if
- SCHED 0, NEXTAC, IDE
- end if
-
- case NEXTAC
- if server > 0 and NQ(other) > 0 then
- SCHED 0, MATCH, IDE
- else
- QUEUE IDE, 0
- end if
-
- case MATCH
- if IDE = MREQ then
- DISPOS
- find2
- else
- find1
- end if
- if NCEN > 0 then SCHED 0, STARTA, IDE
-
- case STARTA
- server = server - 1
- SCHED RN(10, 2), ENDACT, IDE
-
- case ENDACT
- DISPOS
- server = server + 1
- if NQ(MAINP) > 0 and NQ(COVER) > 0 then
- CREATE 0, MREQ
- end if
-
- end select
- end if
- loop while ecode > 0
-
- title$ = " "
- SUMRY sadd(title$)
-
- sub find1
- i = 1
- o = other
- if NQ(o) > 0 then
- for j = 1 to NQ(o)
- if AIQ(o, i, 1) = A(1) then exit for
- i = i + 1
- next j
- end if
-
- if i <= NQ(o) then
- DISPOS
- REMVFQ o, i
- SCHED 0, STARTA, IDE
- else
- QUEUE IDE, 0
- end if
- end sub
-
- sub find2
- found = 0
- j = 1
- do
- colr = AIQ(MAINP, j, 1)
- i = 1
- if NQ(COVER) > 0 then
- for k = 1 to NQ(COVER)
- if AIQ(COVER, k, 1) = colr then exit for
- i = i + 1
- next k
- end if
-
- if i <= NQ(COVER) then
- REMVFQ COVER, i
- DISPOS
- REMVFQ MAINP, j
- found = 1
- else
- j = j + 1
- end if
- loop while found = 0 and j <= NQ(MAINP)
- end sub
-
- function other
- if IDE = MAINP then other = COVER else other = MAINP
- end function
-
- sub prime
- server = 1
- INIQUE 2, 1, 1
- SIMEND 150
- CREATE EX(12), MAINP
- CREATE EX(12), COVER
- end sub
-